# Usage: transform.tcl
# In: bretwalda.orig.ps. Out: bretwalda.base.ps.
# Splits off parts 1, 2 and 3 into separate procedures.
# Reads Part1 and replaces all mountain fills with M and all land fills with L.

package require Iexpect

set eNumber "\[-\]?\[0-9.\]+"

cd [file dirname [info script]]

# First pass: Extracting the info data
set coordinates []
array set names {}
array set types {}
set I [iexpect::Expect #auto -white -file "bretwalda.orig.ps" -encoding "iso8859-1"]
$I expect line "^/SpaceInfo <<$" {
	set name ""
	$I expect line "^>> def" {
	} "^/(\\w+) <<$" {
		set name [$I get match 1]
		$I continue
	} "^/Name \\((.+)\\)$" {
		set names($name) [$I get match 1]
		$I continue
	} default {
		$I continue
	}
	$I continue	
} "^/VisitTerritories \\\{" {
	$I expect line "^\\\} bind def" {
	} "^/(\\w+) ($eNumber) ($eNumber) (\\w)$" {
		lappend coordinates [list [$I get match 2] [$I get match 3] [$I get match 1]]
		lappend types([$I get match 4]) [$I get match 1]
		$I continue
	} default {
		$I continue
	}
	$I continue
} default {
	$I continue
}
itcl::delete object $I

# Second pass: Parsing the contour data and outputting
set I [iexpect::Expect #auto -white -file "bretwalda.orig.ps" -encoding "iso8859-1"]
set you [open "bretwalda.base.ps" w]
# Insert the info data after the document comments
$I expect line "^%%EndComments$" {
	puts $you [$I get output]
	puts $you ""
	puts $you "% INFO"
	foreach position $coordinates {
		puts $you "% $position $names([lindex $position 2])"
	}
	puts $you "% MAP"
} default {
	puts $you [$I get output]
	$I continue
}
# Search for Part1.
$I expect line "^% First part: " {
	puts $you "SeaColor"
	puts $you "BBllx BBlly BBurx BBllx sub BBury BBlly sub rectfill"
	puts $you ""
	puts $you "Part1 Part2 Part3"
	puts $you ""
	puts $you "%ShowUnitGrids"
	puts $you ""
	puts $you "grestore"
	puts $you ""
	puts $you "end"
	puts $you ""
	puts $you "\} bind def"
	puts $you ""
	puts $you [$I get output]
	puts $you "/Part1 \{"
	# Search for the list of Mountains and replace the other definitions with simple ones for L and M.
	$I expect line "/Mountains \[\[\] ((\[0-9.\]+ )+)\[\]\] def" {
		set mountains [$I get match 1]
		$I continue
	} " rectfill$" {
		puts $you ""
		puts $you "/L { LandColor fill } bd"
		puts $you "/M { MountainColor } bd"
	} default {
		$I continue
	}
	# Go through all following parts, replacing S with either L or M.
	set idx 0
	set partNr 0
	$I expect line "^% Second part: " {
		puts $you "\} bind def"
		puts $you ""
		puts $you [$I get output]
		puts $you "/Part2 \{"
	} "^S$" {
		if {$idx < [llength $mountains] && $partNr == [lindex $mountains $idx]} {
			puts $you "M"
			incr idx
		} else {
			puts $you "L"
		}
		incr partNr
		$I continue
	} "^@rax " {
		$I continue
	} " (@G|K|@w|def|ld)$" {
		$I continue
	} default {
		puts $you [$I get output]
		$I continue
	}
	$I expect line "^% Third part: " {
		puts $you "\} bind def"
		puts $you ""
		puts $you [$I get output]
		puts $you "/Part3 \{"
	} "^@rax " {
		$I continue
	} " (@G|K|@w|def|ld)$" {
		$I continue
	} default {
		puts $you [$I get output]
		$I continue
	}
	$I expect line "^%ShowUnitGrids$" {
		$I expect line "^\\\} bind def$" {
			puts $you [$I get output]
		} default {
			$I continue
		}
	} "^@rax " {
		$I continue
	} " (@G|K|@w|def|ld)$" {
		$I continue
	} default {
		puts $you [$I get output]
		$I continue
	}
	$I continue
} default {
	puts $you [$I get output]
	$I continue
}
close $you
itcl::delete object $I

# List the types
foreach {type provinces} [array get types] {
	puts "$type: $provinces"
}